home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL2NO3.ARC / DAT.LSP next >
Encoding:
Text File  |  1987-05-18  |  3.4 KB  |  115 lines
  1. ;   Datum Dimensioning by Charles Niesley
  2. ;   12/86
  3. ;
  4. (defun hdraw (txtdim)
  5. (command "line" (list (car pt2) (- (cadr pt2) A))
  6.          (list (car pt2) (- (cadr pt0b) B)))
  7. (command)
  8. (command "text" "r" (list (+ (car pt2) A) (- (cadr pt0b) C)) D 90 txtdim))_
  9. (defun C:BOTTOM ()
  10. (setvar "cmdecho" 0)
  11. (setvar "highlight" 0)
  12. (if (null scl) (setq scl (getvar "ltscale")))
  13. (setq A (* scl 0.06))   ;    dim line offset from selected point
  14. (setq B (* scl 0.44))   ;    dim line length from origin
  15. (setq C (* scl 0.50))   ;    text offset from origin
  16. (setq D (* scl 0.125))  ;    text height
  17. (setq pt1 (getpoint "\nSelect origin, or press RETURN: "))
  18. (if (/= pt1 nil) (progn (setq pt0b pt1) (setq pt2 pt0b)
  19. (hdraw "0")))
  20. (setq pt2 1)
  21. (while pt2
  22.          (setq pt2 (getpoint "\nSelect next point: "))
  23.          (if (= (type pt2) 'list)
  24.               (hdraw (rtos (abs (- (car pt2) (car pt0b))) 2
  25. (getvar "luprec")))
  26.               (setq pt2 nil))
  27. )
  28. (setvar "highlight" 1)
  29. )
  30. (defun vdraw (txtdim)
  31. (command "line" (list (- (car pt2) A) (cadr pt2))
  32.           (list (- (car pt01) B) (cadr pt2)))
  33. (command)
  34. (command "text" "r" (list (- (car pt01) C) (- (cadr pt2)
  35. A))
  36.           D 0 txtdim)
  37. )
  38. (defun C:LEFT ()
  39. (setvar "cmdecho" 0)
  40. (setvar "highlight" 0)
  41. (if (null scl) (setq scl (getvar "ltscale")))
  42. (setq A (* scl 0.06))
  43. (setq B (* scl 0.44))
  44. (setq C (* scl 0.50))
  45. (setq D (* scl 0.125))
  46. (setq pt1 (getpoint "\nSelect origin, or press RETURN: "))
  47. (if (/= pt1 nil) (progn (setq pt01 pt1) (setq pt2 pt01)
  48. (vdraw "0")))
  49. (setq pt2 1)
  50. (while pt2
  51.           (setq pt2 (getpoint "\nSelect next point: "))
  52.           (if (= (type pt2) 'list)
  53.                (vdraw (rtos (abs (- (cadr pt2) (cadr pt01))) 2
  54.                       (getvar "luprec")))
  55.           (setq pt2 nil))
  56. )
  57. (setvar "highlight" 1)
  58. )
  59. (defun thdraw (txtdim)
  60. (command "line" (list (car pt2) (+ (cadr pt2) A))
  61.           (list (car pt2) (+ (cadr pt0t) B)))
  62. (command)
  63. (command "text" (list (+ (car pt2) A) (+ (cadr pt0t) C)) D 90 txtdim)
  64. )
  65. (defun C:TOP ()
  66. (setvar "cmdecho" 0)
  67. (setvar "highlight" 0)
  68. (if (null scl) (setq scl (getvar "ltscale")))
  69. (setq A (* scl 0.06))
  70. (setq B (* scl 0.44))
  71. (setq C (* scl 0.44))
  72. (setq D (* scl 0.125))
  73. (setq pt1 (getpoint "\nSelect origin, or press RETURN: "))
  74. (if (/= pt1 nil) (progn (setq pt0t pt1) (setq pt2 pt0t)
  75. (thdraw "0")))
  76. (setq pt2 1)
  77. (while pt2
  78.           (setq pt2 (getpoint "\nSelect next point: "))
  79.           (if (= (type pt2) 'list)
  80.                (thdraw (rtos (abs (- (car pt2) (car pt0t))) 2
  81. (getvar "luprec")))
  82.                (setq pt2 nil))
  83. )
  84. (setvar "highlight" 1)
  85. )
  86.  
  87. (defun rvdraw (txtdim)
  88. (command "line" (list (+ (car pt2) A) (cadr pt2))
  89.           (list (+ (car pt0r) B) (cadr pt2)))
  90. (command)
  91. (command "text" (list (+ (car pt0r) C) (- (cadr pt2) A))
  92.           D 0 txtdim)
  93. )
  94. (defun C:RIGHT ()
  95. (setvar "cmdecho" 0)
  96. (setvar "highlight" 0)
  97. (if (null scl) (setq scl (getvar "ltscale")))
  98. (setq A (* scl 0.06))
  99. (setq B (* scl 0.44))
  100. (setq C (* scl 0.50))
  101. (setq D (* scl 0.125))
  102. (setq pt1 (getpoint "\nSelect origin, or press RETURN: "))
  103. (if (/= pt1 nil) (progn (setq pt0r pt1) (setq pt2 pt0r)
  104. (rvdraw "0")))
  105. (setq pt2 1)
  106. (while pt2
  107.           (setq pt2 (getpoint "\nSelect next point: "))
  108.              (if (= (type pt2) 'list)
  109.                (rvdraw (rtos (abs (- (cadr pt2) (cadr pt0r))) 2
  110. (getvar "luprec")))
  111.                (setq pt2 nil))
  112. )
  113. (setvar "highlight" 1)
  114. )
  115.